package cllogging;

use Carp qw(cluck);
use strict;

sub new {
my $self;
my $class=shift;
my $file=$_[0];
my $lwidth=$_[1];

	$lwidth=106 if !defined($lwidth);
	if(!defined($file)) {
		cluck("Missing mandatory filename argument.");
		return undef;
	}

	#################################################################
	# If the file already exists make sure it is writable and if	#
	# not abort.							#
	#################################################################

	if(-e $file) {
		if(! -f $file) {
			cluck("File specified is not a regular file.");
			return undef;
		}
		if(! -w $file) {
			cluck("File specified is not writable.");
			return undef;
		}
	}
	my ($fd,$cfd);
	if(!open($fd,">>$file")) {
		cluck("Unable to open file '$file' in write/append mode - $!");
		return undef;
	}
	$self->{FD}=$fd;
	$self->{file}=$file;
	$self->{lwidth}=$lwidth;
	$self->{debug}=0;
	$self->{verbose}=0;
	$self->{warning}=0;
	$self->{error}=1;
	$self->{date}="000000";

	my $cfg=select($fd);
	$|=1;
	select($cfg);
	bless($self,$class);
	return $self;
}

sub set_debug {
my $self=shift;

	$self->{debug}=1;
	$self->{verbose}=1;
	$self->{warning}=1;
	$self->{error}=1;
}

sub set_verbose {
my $self=shift;

	$self->{debug}=0;
	$self->{verbose}=1;
	$self->{warning}=1;
	$self->{error}=1;
}

sub set_quiet {
my $self=shift;

	$self->{debug}=0;
	$self->{verbose}=0;
	$self->{warning}=1;
	$self->{error}=1;
}

sub set_silent {
my $self=shift;

	$self->{debug}=0;
	$self->{verbose}=0;
	$self->{warning}=0;
	$self->{error}=0;
}

sub _format_str {
my $self=shift;
my $txt=shift;
my $pref=shift;
my @L=();
my $cline;

	my $width=$self->{lwidth};
	my @W=split(/\s+/,$txt);
	$pref="" if !defined($pref);
	$cline="$pref";
	foreach (@W) {
		if(length($cline)+length($_)+2 > $width) {
			push @L,$cline;
			$cline="$pref $_";
		} else {
			$cline.=" $_";
		}
	}
	push @L,$cline;
	return (@L);
}

sub msg {
my $self=shift;
my $type=shift;
my $msg=shift;
my $pref;

	if(!defined($type) || !defined($msg)) {
		cluck("Missing mandatory type or message argument.");
		return;
	}
	$type=lc($type);
	if(!scalar(grep {/^$type$/} qw(msg warn error debug))) {
		cluck("Message type '$type' is unknown.");
		return;
	}

	if($type eq "debug" && $self->{debug}) {
		$pref="DEBUG";
	}
	if($type eq "msg" && $self->{verbose}) {
		$pref="LOG";
	}
	if($type eq "warn" && $self->{warning}) {
		$pref="WARN";
	}
	if($type eq "error" && $self->{error}) {
		$pref="ERROR";
	}
	return if !defined($pref);
	my @m=localtime(time);
	my $ti=sprintf("%02d%02d%02d [%5d] %-5s ",$m[2],$m[1],$m[0],$$,$pref);
	my $da=sprintf("%02d/%02d/%02d",$m[5]+1900,$m[4]+1,$m[3]);
	my @L=_format_str($self,$msg,$ti);
	my $fd=$self->{FD};
	if($da ne $self->{date}) {
		$self->{date}=$da;
		print $fd "Date: $da\n";
	}
	print $fd "$_\n" foreach (@L);
	if(exists($self->{tagged})) {
		$self->{tagged}->msg($type,$msg);
	}
}

sub tag_other_log {
my $self=shift;

	$self->{tagged}=$_[0];
}

1;

